TPUG - Toronto PET Users Group/TPUG Users Group CD/TPUG Users Group CD.iso/CRS/crs20.d81/frcscp64.sfx/fracscapes64

Commodore BASIC | 1990-02-12 | 15KB | 512 lines

10 REM         FRACSCAPES 64
20 REM              OR
30 REM    3-D FRACTAL LANDSCAPES
40 REM
50 REM   BY MICHIEL VAN DE PANNE
60 REM FROM THE JULY ISSUE OF CREATIVE
70 REM     COMPUTING (R.I.P.)
80 REM
90 REM    HACKED UNMERCIFULLY AND
100 REM   MODIFIED FOR THE AMIGA FROM
110 REM    THE MAC VERSION BY
120 REM DAVID MILLIGAN, 70707,2521
130 REM     AND TED INGALLS
140 REM         10-19-85
150 REM
160 REM  ** THIS PROGRAM WILL CONSTRUCT
170 REM  ** A REALISTIC 3-D LANDSCAPE
180 REM  ** FRACTAL FROM MANY RANDOM
190 REM  ** NUMBERS IN UP TO SEVEN
200 REM  ** LEVELS OF DETAIL,SIMULATING
210 REM  ** MOUNTAIN RANGES, COASTLINES
220 REM  ** SEA FLOOR AND/OR SURFACES,
230 REM  ** LAKES,ISLANDS,ETC.
240 REM  ** ONCE THE ARRAY USED TO DO
250 REM  ** THE DRAWING IS CREATED,IT
260 REM  ** CAN BE SAVED TO DISK AND
270 REM  ** RELOADED AND RE-DRAWN.
280 REM  **  WE SAVED THE ARRAY RATHER
290 REM  ** THAN THE SCREEN BECAUSE:
300 REM  **  (1) WE COULDN'T FIGURE OUT
310 REM  ** HOW TO FIND THE START OF
320 REM  ** SCREEN MEMORY FROM ABASIC
330 REM  ** AND COULDN'T GET A 640X200
340 REM  ** SCREEN STUFFED INTO AN
350 REM  ** ARRAY, AND
360 REM  **  (2) THE ARRAY CAN BE
370 REM  ** RE-DRAWN WITH DIFFERENT
380 REM  ** SCALING FACTORS FOR
390 REM  ** PERSPECTIVE CHANGES AND
400 REM  ** WITH SEA LEVEL ON OR OFF
410 REM  ** (DEFAULT IS OFF).
420 REM  ** THE LENGTH OF TIME REQUIRED
430 REM  ** TO DRAW AN ARRAY DEPENDS
440 REM  ** ON THE NUMBER OF LEVELS
450 REM  ** SELECTED. FOR EACH INCREASE
460 REM  ** IN LEVEL THE NUMBER OF
470 REM  ** TRIANGULAR SUBDIVISIONS IS
480 REM  ** QUADRUPLED. A LEVEL 7
490 REM  ** LANDSCAPE HAS THE HIGHEST
500 REM  ** 'RESOLUTION', BUT TAKES
510 REM  ** OVER AN HOUR TO DRAW.
520 REM
530 REM  **  ONE OF THE MAIN THINGS WE
540 REM  ** ADDED TO THE ORIGINAL
550 REM  ** PROGRAM WAS COLOR. THE 12
560 REM  ** COLORS ARE SELECTED BY WHAT
570 REM  ** WE DETERMINED WAS ALTITUDE
580 REM  ** TO RENDER FORESTS,WATER
590 REM  ** SNOW, DIRT, ETC.
600 REM  **  CONSIDERING WE UNDERSTAND
610 REM  ** VITUALLY NOTHING OF THE
620 REM  ** MATH INVOLVED, IT WORKS
630 REM  ** PRETTY WELL.
640 REM  **  IF YOU'VE GOT A BETTER
650 REM  ** IDEA, HAVE AT IT.
660 REM  **  THIS PROGRAM IS DEFINATELY
670 REM  ** NOT POLISHED,OPTIMIZED OR
680 REM  ** BUG FREE, BUT IT IS FUN TO
690 REM  ** PLAY WITH.
700 REM  **  WHILE I DON'T UNDERSTAND
710 REM  ** THEM, I FIND FRACTAL
720 REM  ** GRAPHICS GENERATION
730 REM  ** FASCINATING. IF YOU'VE GOT
740 REM  ** A NIFTY FRACTAL PROGRAM,
750 REM  ** UPLOAD IT HERE OR SING OUT
760 REM  ** VIA E-MAIL.
770 REM
780 REM     DAVID MILLIGAN, 70707,2521
790 REM  ******************************
800 REM
810 REM  ** FRACSCAPE 64 WOULD NOT BE
820 REM  AS NICE WITHOUT THE HIGH
830 REM  RESOLUTION GRAPHICS UTILITY
831 REM  ($C000-$C81F)
840 REM  BY GARY KIZIAK FROM VOLUME
850 REM  5,ISSUE 6 OF TRANSACTOR
860 REM  MAGAZINE. ****THANKS********
872 REM  THE REST OF FILE 'HIHIRES'
873 REM  IS A HIRES SCREEN DUMP
874 REM  PROGRAM ($C820-$CAA0)
875 REM
880 REM  ** THIS PROGRAM WAS CONVERTED
890 REM  FROM AMIGA ABASIC FOR THE C64
900 REM  BY DOUG COWARD (DONQUIXOTE ON
910 REM  Q-LINK)
920 REM
930 REM  THE LOSS OF COLOR THAT THE
940 REM  AMIGA IS CAPABLE OF DOES NOT
950 REM  TAKE AWAY FROM THE BEAUTY OF
960 REM  THESE FRACTALS.
970 REM   STANDARD BITMAP MODE DRAWS IN
980 REM  ONE COLOR (I PICKED DK. GRAY)
990 REM  MULTICOLOR MODE DRAWS IN THREE
1000 REM  COLORS ( DK.GRAY,BLUE,GREEN OR
1010 REM  DK.GRAY,GREEN,WHITE)
1020 REM
1030 REM PN=  **  COLORS  **
1040 REM    SEALEVEL=   0   1   0   1
1050 REM    MC=MULCOLOR 0   0   1   1
1060 REM  0 BACKGROUND  14  14  14  14
1070 REM  1 FOREGROUND  11  11  5   6
1080 REM  2 MULTICOLOR1 --  --  11  5
1090 REM  3 MULTICOLOR2 --  --  1   11
1100 REM  4 BORDER      14  14  14  14
1110 REM  --------------------------
1120 REM  1 = WHITE (SNOW)
1130 REM  6 = BLUE (WATER)
1140 REM  11= DARK GRAY (ROCK)
1150 REM  5 = GREEN (FOREST)
1160 REM  14= LIGHT BLUE (SKY)
1170 REM
1180 REM   THIS PROGRAM CAN BE IMPROVED.
1190 REM  IF YOU HAVE IMPROVEMENTS OR IF
1200 REM  UNDERSTAND THE MATH OF FRACTAL
1210 REM  SEND E-MAIL.   ** ENJOY **
1220 REM      DOUG COWARD
1230 REM =============================
1235 IF A=0 THEN A=1:LOAD "HIHIRES",8,1
1240 HI=12*4096:DR=HI+3:PL=DR+3:MO=PL+3:CL=MO+3:DM=CL+3:
1250 SC=DM+3:CO=SC+3:BO=CO+3:TE=BO+3:PR=TE+3:CH=PR+3:TR=CH+3
1260 PRINTCHR$(147):SYSTRAP:PI=3.14159:GOSUB1430:PRINT CHR$(158)
1270 PRINT"         FRACSCAPES 64"
1280 PRINT"  THIS PROGRAM WAS CONVERTED FROM AMIGA "
1290 PRINT" ABASIC FOR THE C64 BY DOUG COWARD"
1300 PRINT"                      (DONQUIXOTE)"
1310 PRINT" SELECT STANDARD HIRES":PRINT" (ONE COLOR)"
1320 PRINT" OR SELECT MULTICOLOR BITMAP MODE FOR"
1330 PRINT" THREE COLORS AT LOWER RESOLUTION"
1340 REM *** PROGRAM INITIALIZATION ***
1350 PRINT"     INITIALIZING ARRAYS"
1360 DIMD(64,33):LE=0
1370 GOSUB4870:FORI=1TO2000:NEXT:GOTO3120
1380 REM ==============================
1390 REM *** WAIT FOR ANY KEY  ***
1400 GETA$:IFA$=""THEN1400
1410 RETURN
1420 REM ==============================
1430 REM *** SET INITIAL COLORS ***
1440 POKE53280,14:POKE53281,14
1450 C1=11:C2=1:C3=6
1460 RETURN
1470 REM ==============================
1480 REM CALCULATE ARRAY DATA AND INSERT
1490 PRINT"   WORKING ON LEVEL "
1500 DT=2:FORN=1TOLE:DT=DT+2^(N-1):NEXTN
1510 MX=DT-1:MY=MX/2:RH=PI*30/180:VT=RH*1.2
1520 FORN=1TOLE:L=10000/1.8^N
1530 PRINT:PRINT"   ";N
1540 IB=MX/2^N:SK=IB*2
1550 GOSUB1610:REM ASSIGN HEIGHTS ALONG X IN ARRAY
1560 GOSUB1690:REM *** ASSIGN HEIGHTS ALONG Y ***
1570 GOSUB1770:REM *** ASSIGN HEIGHTS ALONG Z ***
1580 NEXTN
1590 PRINTCHR$(147):GOTO3030
1600 REM =============================
1610 REM   *** HEIGHTS ALONG X ***
1620 FORYE=0TOMX-1STEPSK
1630 FORXE=IB+YETOMXSTEPSK
1640 AX=XE-IB:AY=YE:GOSUB1860:D1=D:AX=XE+IB:GOSUB1860:D2=D
1650 D=(D1+D2)/2+RND(1)*L/2-L/4:AX=XE:AY=YE:GOSUB1920
1660 NEXTXE
1670 NEXTYE:RETURN
1680 REM =============================
1690 REM *** HEIGHTS ALONG Y ***
1700 FORXE=MXTO1STEP-SK
1710 FORYE=IBTOXESTEPSK
1720 AX=XE:AY=YE+IB:GOSUB1860:D1=D:AY=YE-IB:GOSUB1860:D2=D
1730 D=(D1+D2)/2+RND(1)*L/2-L/4:AX=XE:AY=YE:GOSUB1920
1740 NEXTYE
1750 NEXTXE:RETURN
1760 REM =============================
1770 REM *** HEIGHTS ALONG Z ***
1780 FORXE=0TOMX-1STEPSK
1790 FORYE=IBTOMX-XESTEPSK
1800 AX=XE+YE-IB:AY=YE-IB:GOSUB1860:D1=D
1810 AX=XE+YE+IB:AY=YE+IB:GOSUB1860:D2=D
1820 AX=XE+YE:AY=YE:D=(D1+D2)/2+RND(1)*L/2-L/4:GOSUB1920
1830 NEXTYE
1840 NEXTXE:RETURN
1850 REM =============================
1860 REM *** RETURN DATA FROM ARRAY ***
1870 IFAY>MYTHEN1890
1880 BY=AY:BX=AX:GOTO1900
1890 BY=MX+1-AY:BX=MX-AX
1900 D=D(BX,BY):RETURN
1910 REM =============================
1920 REM *** PUT DATA INTO ARRAY ***
1930 IFAY>MYTHEN1950
1940 BY=AY:BX=AX:GOTO1960
1950 BY=MX+1-AY:BX=MX-AX
1960 D(BX,BY)=D:RETURN
1970 REM =============================
1980 REM *** SEA LEVEL SECTION ***
1990 IFSEALEVEL=0THENGOSUB2190:RETURN
2000 IFXO<>-999THEN2030
2010 IFZZ<0THENGOSUB2410:Z2=ZZ:ZZ=0:GOTO2170
2020 GOSUB2450:GOTO2160
2030 IFZ2>0ANDZZ>0THENGOSUB2190:GOTO2160
2040 IFZ2<0ANDZZ<0THENZ2=ZZ:ZZ=0:GOTO2170
2050 W3=ZZ/(ZZ-Z2):X3=(X2-XX)*W3+XX:Y3=(Y2-YY)*W3+YY:Z3=0
2060 ZT=ZZ:YT=YY:XT=XX
2070 IFZZ>0THEN2130
2080 REM =============================
2090 REM *** GOING INTO WATER ***
2100 ZZ=Z3:YY=Y3:XX=X3:GOSUB2710
2110 GOSUB2410:ZZ=0:YY=YT:XX=XT:Z2=ZT:GOTO2170
2120 REM =============================
2130 REM *** COMING OUT OF WATER ***
2140 ZZ=Z3:YY=Y3:XX=X3:GOSUB2710
2150 GOSUB2450:ZZ=ZT:YY=YT:XX=XT
2160 Z2=ZZ
2170 X2=XX:Y2=YY:RETURN
2180 REM =============================
2190 REM  *** NEW COLOR SUBROUTINE ***
2200 IFZZ<0THENGOTO2330
2210 REM IF ZZ>950 THEN PENA 2:RETURN
2220 REM IF ZZ>850 THEN PENA 3:RETURN
2230 REM IF ZZ>750 THEN PENA 4:RETURN
2240 IFZZ>750THENPN=C3:GOTO2300
2250 REM IF ZZ>550 THEN PENA 6:RETURN
2260 REM IF  ZZ>450 THEN PENA 7:RETURN
2270 REM IF ZZ>350 THEN PENA 12:RETURN
2280 REM IF ZZ>100 THEN PENA 12:RETURN
2290 GOSUB2450
2300 IFMC=0THENPN=C1
2310 RETURN
2320 REM =============================
2330 REM  *** BELOW SEA LEVEL ***
2340 IFZZ>-200THENGOSUB2410:RETURN
2350 REM IF ZZ>-500 THEN PENA 9:RETURN
2360 REM IF ZZ>-800 THEN PENA 10:RETURN
2370 REM IF ZZ>-1200 THEN PENA 11:RETURN
2380 REM PENA 11
2390 RETURN
2400 REM =============================
2410 REM *** SWITCH TO SEA LEVEL COLOR ***
2420 PN=C1
2430 F1=1:RETURN
2440 REM =============================
2450 REM *** SWITCH TO LAND COLOR ***
2460 IFMC=1THENPN=C2:GOTO2480
2470 PN=C1
2480 F1=0:RETURN
2490 REM =============================
2500 REM   *** ROTATION ***
2510 IFXX<>0THEN2540
2520 IFYY<=0THENRA=-PI/2:GOTO2560
2530 RA=PI/2:GOTO2560
2540 RA=ATN(YY/XX)
2550 IFXX<0THENRA=RA+PI
2560 R1=RA+RH:RD=SQR(XX*XX+YY*YY)
2570 XX=RD*COS(R1):YY=RD*SIN(R1)
2580 RETURN
2590 REM =============================
2600 REM *** TILT DOWN ***
2610 RD=SQR(ZZ*ZZ+XX*XX)
2620 IFXX=0THENRA=PI/2:GOTO2650
2630 RA=ATN(ZZ/XX)
2640 IFXX<0THENRA=RA+PI
2650 R1=RA-VT
2660 XX=RD*COS(R1)+XX:ZZ=RD*SIN(R1)
2670 RETURN
2680 REM =============================
2690 REM *** PLOT TO (XP,YP) ***
2700 GOSUB1980
2710 XX=XX*XS:YY=YY*YS:ZZ=ZZ*ZS
2720 GOSUB2500:REM *** ROTATE ***
2730 GOSUB2600:REM *** TILT UP ***
2740 IFXO=-999THENPR$="M":GOTO2760
2750 PR$="D"
2760 XP=INT(YY)+CX:YP=INT(ZZ)
2770 REM =============================
2780 REM *** DO PLOTTING HERE ***
2790 GETA$:IFA$<>""THEN3120
2800 IFMC=1THENXP=XP/2
2810 XP=XP*.70:YP=140.47+.663*YP:IFPR$="M"THENX8=XP:Y8=YP
2820 SYSDRAW,X8,Y8TOXP,YP,PN:X8=XP:Y8=YP:XO=XP
2830 RETURN
2840 REM =============================
2850 REM *** PLOT X AXIS ***
2860 FORAX=0TOMX:XO=-999:FORAY=0TOAX
2870 GOSUB1860:ZZ=D:YY=AY/MX*10000:XX=AX/MX*10000-YY/2
2880 GOSUB2690:NEXTAY:NEXTAX
2890 RETURN
2900 REM =============================
2910 REM *** PLOT Y AXIS ***
2920 FORAY=0TOMX:XO=-999:FORAX=AYTOMX
2930 GOSUB1860:ZZ=D:YY=AY/MX*10000:XX=AX/MX*10000-YY/2
2940 GOSUB2690:NEXTAX:NEXTAY
2950 RETURN
2960 REM =============================
2970 REM *** PLOT Z AXIS ***
2980 FOREX=0TOMX:XO=-999:FOREY=0TOMX-EX
2990 AX=EX+EY:AY=EY:GOSUB1860:ZZ=D:YY=AY/MX*10000
3000 XX=AX/MX*10000-YY/2:GOSUB2690:NEXTEY:NEXTEX
3010 RETURN
3020 REM =============================
3030 REM   *** SETUP SCREEN ***
3040 IFMC=1THENSYSHIRES,1,4,C2,C1,C3:GOTO3060
3050 SYSHIRES,0,4,C1
3060 POKE53280,4:TAX=AX:TAY=AY
3070 GOSUB2970:REM ** PLOT Z AXIS **
3080 GOSUB2910:REM ** PLOT Y AXIS **
3090 GOSUB2850:REM ** PLOT X AXIS **
3100 GOSUB1390
3110 REM =============================
3120 REM *** MAIN MENU SECTION ***
3130 SYSTEXT:PRINTCHR$(147)
3140 POKE53280,14:POKE53281,14
3150 PRINT"   CURRENT SETTINGS:":PRINT
3160 IFMC=0THENPRINT" STANDARD BITMAP MODE"
3170 IFMC=1THENPRINT" MULTICOLOR BITMAP MODE"
3180 PRINT" SEALEVEL OPTION ";:IFSEALEVEL=0THENPRINT"OFF"
3190 IFSEALEVEL<>0THENPRINT"ON"
3200 PRINT" SCALE - X=";XS;" Y=";YS;" Z=";ZS
3210 PRINT"    -) MAIN MENU (-"
3220 PRINT"   1 - START NEW LANDSCAPE"
3230 PRINT"   2 - DRAW EXISTING ARRAY"
3240 PRINT"   3 - DISPLAY CURRENT HIRES SCREEN"
3250 PRINT"   4 - SAVE FRACTAL ARRAY OR SCREEN"
3260 PRINT"   5 - LOAD FRACTAL ARRAY OR SCREEN"
3270 PRINT"   6 - RESET SCALING FACTORS"
3280 PRINT"   7 - SET SEA LEVEL OPTIONS"
3290 PRINT"   8 - SWITCH BITMAP MODE"
3300 PRINT"   9 - PRINT HIRES SCREEN"
3310 PRINT"   0 - EXIT TO BASIC"
3320 PRINT:PRINT
3330 PRINT"          SELECTION (0-9) ";
3340 GETA$:IFA$<"0"ORA$>"9"THEN3340
3350 A=ASC(A$)-48:PRINTCHR$(147)
3360 ONAGOTO3410,4580,4290,3570,3890,4680,4340,4430,3490
3370 REM =============================
3380 REM *** PROGRAM EXIT ***
3390 PRINTCHR$(147):END
3400 REM =============================
3410 PRINT" ** START A NEW FRACTAL LANDSCAPE **"
3420 PRINT"  ENTER NUMBER OF LEVELS (1-6)";:INPUTLE
3430 PRINTCHR$(147):IFLE<1ORLE>6THEN3420
3440 PRINT"    PRESS ANY KEY TO START."
3450 PRINT"  PRESS WHILE DRAWING TO ABORT."
3460 GOSUB1390:PRINTCHR$(147)
3470 GOTO1480
3480 REM =============================
3490 PRINT "PRINT HIRES SCREEN TO COMMODORE PRINTER"
3500 PRINT "AS DEVICE 4":PRINT
3505 PRINT" PRESS 1  FOR 1/4 PAGE SIZE"
3507 PRINT"       2  FOR FULL PAGE SIZE"
3508 GETA$:IF A$<"1"ORA$>"2"THEN3508
3509 POKE2,2:IF A$="1" THEN POKE2,1
3510 IF MC=0 THEN SYSHIRES,0:GOTO 3530
3520 SYSHIRES,1
3530 SYS51232
3550 GOTO 3120
3560 REM =============================
3570 PRINT"     *** ARRAY OR SCREEN SAVE ***"
3580 NAME$="":SL=0:SH=0:EL=0:EH=0
3590 PRINT" TO SAVE THE SCREEN, THE COLOR SCREEN"
3600 PRINT" IS MOVED TO $5C00 AND THE BITMAP IS"
3610 PRINT" MOVED TO $6000 AND SAVED. THIS TRASHES"
3620 PRINT" THE ARRAY SO IF YOU WANT BOTH THEN"
3630 PRINT" SAVE THE ARRAY FIRST."
3640 PRINT"     PRESS A TO SAVE ARRAY"
3650 PRINT"           S TO SAVE HIRES SCREEN"
3660 PRINT"           X TO EXIT"
3670 PRINT"             SELECTION ";:INPUTA$
3680 IFA$="A"THENA$="ARRAY":GOSUB3720:NAME$=NAME$+".ARY":GOTO3810
3690 IFA$="S"THENA$="SCREEN":GOSUB3720:NAME$=NAME$+".SCN":GOTO3740
3700 IFA$<>"X"THEN3670
3710 PRINTCHR$(147):GOTO3120:REM EXIT
3720 PRINT"  EXTENSION '.ARY' OR '.SCN' IS ADDED TO  YOUR FILENAME"
3730 PRINT"     SAVE ";A$;" AS -> ";:INPUTNAME$:RETURN
3740 DATA 120,169,48,133,1,160,0,162,4,32,237,203,169,224,141,239,203,162
3750 DATA 32,32,237,203,169,55,133,1,88,96,185,0,204,153,0,92,200,208,247,238
3760 DATA 239,203,238,242,203,202,208,238,96
3770 FOR I=52177 TO 52223:READ A:POKE I,A:NEXT I
3780 SYS 52177:REM MOVE SCREEN DOWN TO $5C00
3790 SL=0:SH=92:EL=0:EH=128
3800 GOTO3850
3810 D(0,33)=LE:D(1,33)=MX:D(2,33)=MY:D(3,33)=TAX:D(4,33)=TAY
3820 D(5,33)=XS:D(6,33)=YS:D(7,33)=ZS:D(8,33)=SEALEVEL:D(9,33)=MC
3830 SL=PEEK(47):SH=PEEK(48):EL=PEEK(49):EH=PEEK(50)
3840 REM BSAVE NAME$,A%,L%
3850 SYS57812(NAME$),8:POKE193,SL:POKE194,SH:POKE174,EL:POKE175,EH:SYS62954
3860 PRINTCHR$(147)
3870 GOTO4240
3880 REM =============================
3890 PRINT"     *** ARRAY OR SCREEN LOAD ***"
3900 NAME$=""
3910 PRINT" THE SCREEN IS LOADED AT $5C00 "
3915 PRINT"THE COLOR SCREEN IS MOVED UP TO $CC00"
3930 PRINT"AND THE BITMAP IS MOVED TO $E000"
3940 PRINT"  THIS TRASHES THE ARRAY SO IF YOU "
3950 PRINT"WANT TO LOAD BOTH THEN LOAD THE"
3960 PRINT"HIRES SCREEN FIRST."
3970 PRINT"     PRESS A TO LOAD ARRAY"
3980 PRINT"           S TO LOAD HIRES SCREEN"
3990 PRINT"           X TO EXIT"
4000 PRINT"             SELECTION ";:INPUTA$
4010 IFA$="A"THENA$="ARRAY":GOSUB4050:NAME$=NAME$+".ARY":GOTO4090
4020 IFA$="S"THENA$="SCREEN":GOSUB4050:NAME$=NAME$+".SCN":GOTO4080
4030 IFA$<>"X"THEN4000
4040 PRINTCHR$(147):GOTO3120:REM EXIT
4050 PRINT"ENTER THE FILENAME WITHOUT THE EXTENSION '.ARY' OR '.SCN'"
4060 PRINT"  NAME OF ";A$;" TO LOAD -> ";:INPUTNAME$:RETURN
4070 RETURN
4080 REM LOAD SCREEN
4082 SYS57812(NAME$),8:POKE195,0:POKE196,92:POKE780,0:SYS62626
4084 FOR I=0TO1023:POKE52224+I,PEEK(23552+I:NEXT
4086 FOR I=0TO8191:POKE57344+I,PEEK(24576+I:NEXT:GOTO 4240
4090 REM LOAD ARRAY
4100 SYS57812(NAME$),8:POKE195,PEEK(47):POKE196,PEEK(48):POKE780,0:SYS62626
4110 LE=D(0,33):MX=D(1,33):MY=D(2,33):AX=D(3,33):AY=D(4,33)
4120 XS=D(5,33):YS=D(6,33):ZS=D(7,33):SEALEVEL=D(8,33):MC=D(9,33)
4130 PRINTCHR$(147)
4140 PRINT"ARRAY NAME -> ";NAME$
4150 PRINT"NUMBER OF LEVELS -> ";LE
4160 IFSEALEVEL=0THENLEVEL$="OFF":GOTO4180
4170 LEVEL$="ON"
4180 PRINT"SEA LEVEL DISPLAY -> ";LEVEL$
4190 IFMC=0THENPRINT"BITMAP MODE  -> STANDARD"
4200 IFMC=1THENPRINT"BITMAP MODE  -> MULTICOLOR"
4210 PRINT"SCALING VALUES ->  X=";XS
4220 PRINT"                   Y=";YS
4230 PRINT"                   Z=";ZS
4240 PRINT" PRESS ANY KEY TO CONTINUE"
4250 GOSUB1390
4260 PRINTCHR$(147)
4270 GOTO3120
4280 REM =============================
4290 REM ** REDISPLAY BITMAP SCREEN **
4300 IFMC=1THENSYSHIRES,1:GOTO4320
4310 SYSHIRES,0
4320 POKE53280,4:GOSUB1390:GOTO3120
4330 REM =============================
4340 PRINT"     *** SET SEA LEVEL OPTION ***"
4350 PRINT"  DISPLAY SEA LEVEL SURFACE (Y/N) ";:INPUTA$
4360 IFA$="Y"THEN GOTO4390
4370 SEALEVEL=0:IF MC=0 THEN C1=11:GOTO4410
4380 C1=5:C2=11:C3=1:GOTO4410
4390 SEALEVEL=1:IF MC=0 THEN C1=11:GOTO4410
4400 C1=6:C2=5:C3=11
4410 PRINTCHR$(147):GOTO 3120
4420 REM =============================
4430 PRINT"     *** SET BITMAP MODE ***"
4440 PRINT"  (S)TANDARD BITMAP"
4450 PRINT"  (M)ULTICOLOR BITMAP"
4460 PRINT"  SELECT BITMAP MODE (S/M):";:INPUTA$
4470 IF A$="M" THEN 4490
4480 MC=0:C1=11:GOTO4510
4490 MC=1:IF SEALEVEL=0 THEN C1=5:C2=11:C3=1:GOTO 4510
4500 C1=6:C2=5:C3=11
4510 PRINTCHR$(147):GOTO 3120
4520 REM =============================
4530 REM  ***  ERROR TRAP ***
4540 REM ONERRORGOTO4540
4550 A=0
4560 GOTO3120
4570 REM =============================
4580 PRINT"     *** REDRAW OLD ARRAY ***"
4590 IFLE=0THEN3120
4600 RH=PI*30/180:VT=RH*1.2
4610 PRINT" CLEAR SCREEN BEFORE RE-DRAW (Y/N):";:INPUTA$
4620 PRINTCHR$(147)
4630 IFA$="Y"THEN GOTO 3030
4640 POKE53280,4:IFMC=1THENSYSHIRES,1:GOTO4660
4650 SYSHIRES,0
4660 GOTO 3060
4670 REM =============================
4680 REM *** SCALING SETTINGS ***
4690 SYSTEXT:PRINTCHR$(147)
4700 PRINT"    CURRENT SCALING SETTINGS :"
4710 PRINT:PRINT"             X=";XS
4720 PRINT"             Y=";YS
4730 PRINT"             Z=";ZS
4740 PRINT"     PRESS C TO CHANGE SETTINGS"
4750 PRINT"           D FOR DEFAULT SETTINGS"
4760 PRINT"           X TO EXIT"
4770 REM GOSUB4500
4780 PRINT"             SELECTION ";:INPUTA$
4790 IFA$="C"THEN4840
4800 IFA$="D"THENGOSUB4870:GOTO4830
4810 IFA$<>"X"THEN4830
4820 PRINTCHR$(147):GOTO3120
4830 PRINTCHR$(147):GOTO4700
4840 PRINT"    INPUT NEW X,Y,Z ";:INPUTXS,YS,ZS
4850 GOTO4830
4860 REM =============================
4870 REM *** STOCK SCALING FACTORS ***
4880 XS=.04:YS=.04:ZS=.05:RETURN
4890 REM =============================
4900 REM **** ERROR TRAP ****
4910 FMEM%=FRE(1)
4920 REM "RATS - AN ERROR OCCURRED"
4930 SYSTEXT:PRINTCHR$(147)
4950 PRINT"THERE ARE ";FMEM%;" BYTES OF MEMORY "
4955 PRINT"    PRESS 'E' TO EXIT TO BASIC"
4960 PRINT"    PRESS ANY KEY TO CONTINUE...."
4970 GOSUB1390
4980 PRINTCHR$(147)
4985 IF A$="E" THEN END
4990 GOTO3120